home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: MegaDisc / MegaDisc 38 (1994-02)(MegaDisc Digital Publishing)(AU)(Disk 2 of 2).zip / MegaDisc 38 (1994-02)(MegaDisc Digital Publishing)(AU)(Disk 2 of 2).adf / Programs_2 / Coat_Of_Arms / Coat_of_Arms (.txt) < prev    next >
HyperBook  |  1994-02-05  |  43KB  |  334 lines
  1. 'IXdK
  2. TUQUEU 
  3. TUQUEU 
  4. TUQUEU 
  5. TUQUEU 
  6. d.BT~
  7. B/*  Choice of colour/texture for shield */
  8. /* Get a click on a colour or texture, and clone it to the bin */
  9. /*  Remove previous */
  10. t = SearchName(':','Tinct') ; if t ~= '' then call HML_Delete(t)
  11. obj = Initiator() ; double = Clone(obj,'0:') ;a = getName(obj)
  12. /* If it's a colour, just make the sample object bigger.
  13.    If a texture, then take the whole picture, and make adjustments
  14.    to compensate for its invisible rim. */
  15.  dx = 0 ; dy = 0 ; sc = SetClip('texture',a)
  16.  if a = 'Plain' then dy = -1
  17.  select
  18.   when a = 'Vair' then do ; dx = - 15 ; dy = -8 ;  end
  19.   when a = 'Ermine' then do ; dx = -17; dy = -10 ; end
  20.   otherwise
  21.   call ScaleToSize(double,64,50)
  22.   end
  23.  call SetPosition(double,407+dx,81+dy)
  24.  new =  Relocate(double,':')
  25.  /* Put it behind the frame */
  26.  toback = ObjectToBack(new) ; oldn = SetName(toback,'Tinct')
  27. TintChoice
  28. /*  Add a 'position' to the shield */
  29. shape = GetName(Initiator())
  30. row = GetClickRow('Now click on a colour') ; col = GetColumn()
  31. colour = GetObjectAt(col,row) ; if colour = '' then return
  32. /* Make the patch */
  33.  part = Clone(colour,'0:')
  34.  if shape = 'Sinister' | shape = 'Pale' | shape = 'Dexter' then
  35.    call ScaleToSize(part,22,48 + 2 * (shape = 'Pale'))
  36.    else call ScaleToSize(part,65,16 + 2 * (shape = 'Base'))
  37.    x=406 ; y = 82 ; dx = 0 ; dy = 0
  38. /* Place the patch */
  39.  select
  40.   when shape = 'Pale' then dx = 21
  41.   when shape = 'Sinister' then dx = 42
  42.   when shape = 'Fesse' then dy = 14
  43.   when shape = 'Base' then dy = 28
  44.   otherwise
  45.   end
  46.  call SetPosition(part,x+dx,y+dy) ;  new = Relocate(part,':')
  47.  n = SetName(new,'Part')
  48.  new2 = ObjectToFront(SearchName(':','Frame'))
  49. AddPosition
  50. /* Move any part into the shield */
  51. set = arg(1)
  52. dx = 0 ; dy = 0
  53. obj = Initiator() ; n = GetName(obj)
  54. select
  55.   when set = 1 then
  56.   select
  57.    when n = 'bb' | n = 'ee' then dx = 1
  58.    when n = 'gg' then dx = -1
  59.    when n = 'hh' then do ; dx = -1 ; dy = -1 ; end
  60.    otherwise
  61.    end
  62.   when set = 2 then
  63.   select
  64.    when n = 'aa' | n = 'bb' | n = 'ff' then do ; dx = 1 ; dy = 1 ; end
  65.    when n = 'dd' then dx = -1
  66.    when n = 'hh' then dx = 1
  67.    otherwise
  68.    end
  69.   when set = 3 then do
  70.   dy = 6
  71.   select
  72.    when n = 'aa' then dx = 3
  73.    when n = 'bb' then dx = 19
  74.    otherwise
  75.     dx = 16
  76.    end
  77.   end
  78.   when set = 4 then
  79.   select
  80.    when n = 'aa' then do ; dx = -2 ; dy = -1 ; end
  81.    when n = 'bb' then do ; dx = -3 ; dy = -2 ; end
  82.    when n = 'cc' | n = 'ee' then do ; dx = -1 ; dy = -1 ; end
  83.    when n = 'dd' then dx = -2
  84.    when n = 'ff' then do ; dx = 8 ; dy = 4 ; end
  85.    otherwise
  86.    end
  87.   otherwise
  88.   end
  89.  part = Clone(obj,':')
  90. ol = SetName(part,'Part') ; c = SetActionNone(part)
  91. call SetPosition(part,402+dx,78+dy)
  92. MovePart(page)
  93. /*  Copy shield contents to next screen */
  94. page = arg(1)
  95. fr = SearchName('2:','Frame')
  96. if page = 1 then do
  97.   tinct = SearchName(':','Tinct')
  98.   call NextPage()
  99.   if tinct ~= '' then new = Clone(tinct,':')
  100.   fr = Clone(fr,':') ;  newfr = ObjectToFront(fr)
  101.   end
  102. else do
  103.   group = CreateGroup()
  104.   tinct = SearchName(':','Tinct')
  105.   if tinct ~= '' then new = Clone(tinct,group)
  106.   part = SearchName(':','Part')
  107.   if part ~= '' then do forever
  108.     part2 = Clone(part,group) ; part = SearchName('','Part')
  109.     if part = '' then leave
  110.     end
  111.   call NextPage()
  112.   frame = SearchName(CurrentPage(),'Frame')
  113.  if frame = '' | index(frame,CurrentPage()) = 0 then frame = Clone(fr,group)
  114.   new = Relocate(group,':') ; first = Explode(new)
  115.   f = ObjectToFront('Frame'())
  116.   end
  117. CopyBlock(page)
  118. {/* CleanUp - delete all previous work */
  119.    ti = SearchName('2:','Tinct')
  120.    if ti ~= '' then call HML_Delete(ti)
  121.    type.1 = 'Tinct' ; type.2 = 'Part' ; type.3 = 'Frame'
  122.    do t = 1 to 3
  123.      substr = type.t
  124.      do forever
  125.        obj = SearchName('3:',substr)
  126.        if obj = '' then leave
  127.        call HML_Delete(obj)
  128.        end
  129.      end
  130.      call EndPrompt()
  131.  call NextPage()
  132. CleanUp
  133. /* Remove last */
  134. num = NumElements(':')
  135. do i = num to 0 by -1
  136.   obj = ObjectNumber(':',i) ; if obj = '' then leave
  137.   n = GetName(obj)
  138.   if index(n,'Part') ~= 0 then do
  139.     call HML_Delete(obj) ; leave ; end
  140.   end
  141. RemoveLast
  142. Note1
  143. Tinctures      Positions
  144. Ordinaries     Partition lines
  145. Differencing   Charges
  146.       marks
  147. Note2
  148. Coat of Arms
  149. The following screens will show a few
  150. examples of these aspects of heraldry :
  151.       
  152. Button1
  153. Start
  154. Button2
  155. :CoA_Notes
  156. Notes
  157. Picture1
  158.     Ram Disk:
  159. blank
  160. Page1
  161. "Tinct"
  162. "Vair"
  163.     Ram Disk:
  164.     Tinctures
  165. Note1
  166. Tinctures
  167. Note2
  168.  sable   gules   azure
  169. "Ermine"
  170.     Ram Disk:
  171.     Tinctures
  172. "Black"
  173. "Red"
  174. "Blue"
  175. "Gold"
  176. "Purple"
  177. "Green"
  178. "White"
  179. Note3
  180. or    purpure   vert
  181. Drawing9
  182.     Drawing10
  183. Note4
  184.    argent  ermine   vair
  185. "Plain"
  186. Button1
  187. call CopyBlock(1)
  188.  Next
  189. "Frame"
  190.     Ram Disk:
  191. Frame
  192. Page2
  193. Note1
  194. dexter pale sinister
  195. Note2
  196. chief
  197. fesse
  198. Note3
  199. Positions 
  200. Drawing1
  201. Button1
  202. call CopyBlock(2)
  203.  Next
  204. "Dexter"
  205. "Pale"
  206. "Sinister"
  207. "Chief"
  208. "Fesse"
  209. "Base"
  210. Button2
  211. "Green"
  212. "White"
  213. "Blue"
  214. "Gold"
  215. "Purple"
  216. "Black"
  217. "Red"
  218. "Tinct"
  219. "Frame"
  220.     Ram Disk:
  221. Frame
  222. Page3
  223. Note1
  224. Ordinaries
  225. Button1
  226. Button2
  227. call CopyBlock(2)
  228.  Next
  229. Note2
  230. bend    chevron    pile 
  231. Note3
  232. cross    saltire   annulet
  233. call MovePart(1)
  234.     Ram Disk:
  235. ordinaries
  236. call MovePart(1)
  237.     Ram Disk:
  238. ordinaries
  239. call MovePart(1)
  240.     Ram Disk:
  241. ordinaries
  242. call MovePart(1)
  243.     Ram Disk:
  244. ordinaries
  245. call MovePart(1)
  246.     Ram Disk:
  247. ordinaries
  248. call MovePart(1)
  249.     Ram Disk:
  250. ordinaries
  251. Page4
  252. Note1
  253. per saltire  per chevron  barry
  254. Button1
  255. call CopyBlock(2)
  256.  Next
  257. Note2
  258. Partition lines
  259. Button2
  260. Note3
  261. per fesse   per bend  per pale
  262. call MovePart(2)
  263.     Ram Disk:
  264. partitions
  265. call MovePart(2)
  266.     Ram Disk:
  267. partitions
  268. call MovePart(2)
  269.     Ram Disk:
  270. partitions
  271. call MovePart(2)
  272.     Ram Disk:
  273. partitions
  274. call MovePart(2)
  275.     Ram Disk:
  276. partitions
  277. call MovePart(2)
  278.     Ram Disk:
  279. partitions
  280. Page5
  281. Note1
  282. Collett
  283. AD 1994
  284. Picture1
  285.     Ram Disk:
  286. collett
  287. Button1
  288. Note2
  289. Differencing marks
  290. Note3
  291.     Charges
  292. Note4
  293. first, second, third, fourth, and fifth sons ...
  294. Drawing1
  295. call MovePart(4)
  296. ARexx:
  297. ordinaries
  298. call MovePart(4)
  299.     Ram Disk:
  300. call MovePart(4)
  301.     Ram Disk:
  302. call MovePart(4)
  303.     Ram Disk:
  304. call MovePart(4)
  305.     Ram Disk:
  306. call MovePart(4)
  307.     Ram Disk:
  308. amiga
  309. Button2
  310. Restart
  311. call MovePart(3)
  312.     Ram Disk:
  313. charges
  314. call MovePart(3)
  315.     Ram Disk:
  316. charges
  317. call MovePart(3)
  318.     Ram Disk:
  319. charges
  320. call MovePart(3)
  321.     Ram Disk:
  322. charges
  323. call MovePart(3)
  324.     Ram Disk:
  325. charges
  326. Button3
  327. :Armoury
  328. Armoury
  329. Page6
  330. execute start-qed
  331. Notebook.font
  332. garnet.font
  333. garnet.font
  334.